home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / fftpack / cffti1.f < prev    next >
Text File  |  1995-12-14  |  1KB  |  62 lines
  1.       subroutine cffti1 (n,wa,ifac)
  2.       implicit double precision (a-h,o-z)
  3.       dimension       wa(*)      ,ifac(*)    ,ntryh(4)
  4.       data ntryh(1),ntryh(2),ntryh(3),ntryh(4)/3,4,2,5/
  5.       nl = n
  6.       nf = 0
  7.       j = 0
  8.   101 j = j+1
  9.       if (j-4) 102,102,103
  10.   102 ntry = ntryh(j)
  11.       go to 104
  12.   103 ntry = ntry+2
  13.   104 nq = nl/ntry
  14.       nr = nl-ntry*nq
  15.       if (nr) 101,105,101
  16.   105 nf = nf+1
  17.       ifac(nf+2) = ntry
  18.       nl = nq
  19.       if (ntry .ne. 2) go to 107
  20.       if (nf .eq. 1) go to 107
  21.       do 106 i=2,nf
  22.          ib = nf-i+2
  23.          ifac(ib+2) = ifac(ib+1)
  24.   106 continue
  25.       ifac(3) = 2
  26.   107 if (nl .ne. 1) go to 104
  27.       ifac(1) = n
  28.       ifac(2) = nf
  29.       tpi = 6.28318530717959d0
  30.       argh = tpi/dble(n)
  31.       i = 2
  32.       l1 = 1
  33.       do 110 k1=1,nf
  34.          ip = ifac(k1+2)
  35.          ld = 0
  36.          l2 = l1*ip
  37.          ido = n/l2
  38.          idot = ido+ido+2
  39.          ipm = ip-1
  40.          do 109 j=1,ipm
  41.             i1 = i
  42.             wa(i-1) = 1.
  43.             wa(i) = 0.
  44.             ld = ld+l1
  45.             fi = 0.
  46.             argld = dble(ld)*argh
  47.             do 108 ii=4,idot,2
  48.                i = i+2
  49.                fi = fi+1.
  50.                arg = fi*argld
  51.                wa(i-1) = cos(arg)
  52.                wa(i) = sin(arg)
  53.   108       continue
  54.             if (ip .le. 5) go to 109
  55.             wa(i1-1) = wa(i-1)
  56.             wa(i1) = wa(i)
  57.   109    continue
  58.          l1 = l2
  59.   110 continue
  60.       return
  61.       end
  62.